home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / ODE / Double_List < prev    next >
Encoding:
Text File  |  1991-10-24  |  2.4 KB  |  143 lines
  1. \ Doubly Linked List Support
  2. \ This is similar but not as fancy as an Amiga Exec List
  3. \
  4. \ Author: Phil Burk
  5. \ Copyright 1991 Phil Burk
  6.  
  7. ANEW TASK-DOUBLE_LIST
  8.  
  9. :STRUCT DoubleList
  10.     RPTR dll_Head
  11.     RPTR dll_Tail
  12.     RPTR dll_TailPrev
  13. ;STRUCT
  14.  
  15.  
  16. :STRUCT DoubleNode
  17.     RPTR dln_Next
  18.     RPTR dln_Prev
  19. ;STRUCT
  20.  
  21. \ List handling macros.
  22. \ These pass all JForth relative addresses
  23.  
  24. : DLL.NODE.INIT  ( node -- , initialize node )
  25.     >r ( save node address )
  26.     NULL r@ ..!  dln_next
  27.     NULL r@ ..!  dln_Prev
  28.     rdrop
  29. ;
  30.  
  31. : DLL.NEWLIST ( list -- , Initialize list header.)
  32.     dup ..  dll_Tail over ..!  dll_Head
  33.     dup ..  dll_Head over ..!  dll_TailPrev
  34.     NULL swap ..!  dll_Tail
  35. ;
  36.  
  37. : DLL.EMPTY? ( list -- flag , true if empty )
  38.     ..@  dll_head ..@  dln_next 0=
  39. ;
  40.  
  41. : DLL.FIRST ( list -- first_node , get first node in list )
  42.     ..@  dll_head
  43. ;
  44.  
  45. : DLL.LAST ( list -- last_node , get last node in list )
  46.     ..@  dll_TailPrev
  47. ;
  48.  
  49. : DLL.NEXT ( node -- succeeding_node )
  50.     ..@  dln_next
  51. ;
  52.  
  53. : DLL.PREVIOUS ( node -- succeeding_node )
  54.     ..@  dln_prev
  55. ;
  56.  
  57. : DLL.CONNECT  ( node1 node0 -- , connect node1 after node0)
  58.     2dup swap ( -- n1 n0 n0 n1 ) ..!  dln_Prev
  59.     swap swap ( -- n1 n0 ) ..!  dln_next
  60. ;
  61.  
  62. : DLL.REMOVE ( node -- , remove from list )
  63.     dup dll.next
  64.     over dll.previous
  65.     dll.connect
  66.     dll.node.init
  67. ;
  68.  
  69. : DLL.ADD.TAIL ( node list -- )
  70.     2dup dll.last  ( -- n l n lastn )
  71.     dll.connect
  72.     ..  dll_tail swap dll.connect
  73. ;
  74.  
  75. : DLL.ADD.HEAD ( node list -- )
  76.     2dup dll.first  ( -- n l n firstn )
  77.     swap dll.connect
  78.     dll.connect
  79. ;
  80.  
  81. : DLL.INSERT  ( node1 node0 -- , insert n1 after n0 )
  82.     2dup dll.next swap dll.connect ( n1<->n2 )
  83.     dll.connect ( n0<->n1 )
  84. ;
  85.  
  86. : DLL.END?  ( node -- , is this beyond the last node ? )
  87.     dll.next 0=
  88. ;
  89.  
  90. : DLL.LAST?  ( node -- , is this the last node ? )
  91.     dll.next dll.end?
  92. ;
  93.  
  94. DEFER DLL.PROCESS.NODE ( node )
  95. ' . is DLL.PROCESS.NODE
  96.  
  97. : DLL.SCAN.LIST ( list -- , dump nodes of list )
  98.     dll.first
  99.     BEGIN
  100.         dup dll.next ?dup
  101.     WHILE
  102.         swap dll.process.node
  103.     REPEAT drop
  104. ;
  105.  
  106. \ Test code
  107. true .IF
  108. DOubleList LIST1
  109. DoubleNode NODE1
  110. DoubleNode NODE2
  111. DoubleNode NODE3
  112. DoubleNode NODE4
  113. DoubleNode NODE5
  114.  
  115. : TEL.INIT
  116.     list1 dll.newlist
  117.     node1 dll.node.init
  118.     node2 dll.node.init
  119.     node3 dll.node.init
  120. ;
  121.  
  122. : TEL.LINK
  123.     node1 list1 dll.add.tail
  124.     node2 list1 dll.add.tail
  125.     node3 list1 dll.add.tail
  126. ;
  127.  
  128. : DUMP.NODE ( node -- )
  129.     dup body> >name id.
  130.     dll.last? not
  131.     IF  ."  -> " cr?
  132.     ELSE cr
  133.     THEN
  134. ;
  135.  
  136. : SCANL
  137.     'c dump.node is dll.process.node
  138.     list1 dll.scan.list
  139. ;
  140.  
  141. .THEN
  142.  
  143.